home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
001-025
/
scopedisk21
/
hamhaf
/
ham&haf
< prev
next >
Wrap
Text File
|
1995-03-18
|
4KB
|
190 lines
WINDOW 1,,(20,20)-(600,60)
COLOR 2,1:CLS
PRINT
PRINT " Howdy!"
ON ERROR GOTO NoBMAPS
DECLARE FUNCTION AllocMem& LIBRARY
LIBRARY "exec.library"
LIBRARY "intuition.library"
ON ERROR GOTO 0
GOSUB Help' <-- REM this to speed intro
COLOR 0,1
SCREEN 2,320,200,1,1 :REM *** just ONE Plane
WINDOW 2,,,16,2
PALETTE 0,0,0,0
PALETTE 0,1,1,1
ON BREAK GOSUB Bye
BREAK ON
FOR I%=2 TO 6
CreateNewPlane
COLOR I%,1': LOCATE 1,1
PRINT "I now have";I%;"Planes";
FOR J%=1 TO I%:PRINT "!";:NEXT
PRINT
NEXT
COLOR 2: PRINT: PRINT
PRINT " Use left mouse button
PRINT " to draw.
PRINT ,"OR
PRINT " Click on a color below
PRINT ,"OR
PRINT " Press F1 thru F6 or HELP
PRINT :PRINT :PRINT ,,"JeC 788
GOSUB Colors
HAM
Clr%=3: XY%=MOUSE(0)
X%=MOUSE(1): Y%=MOUSE(2)
'***** MAIN LOOP *****
WHILE 1
XY%=MOUSE(0): oX%=X%: oY%=Y%
X%=MOUSE(1): Y%=MOUSE(2)
IF XY% THEN
IF Y%<194 THEN
LINE(X%,Y%)-(oX%,oY%),Clr%
ELSE
Clr%=ABS(POINT(X%,194))
END IF
END IF
K$=INKEY$: IF K$>"" THEN GOSUB Keys
WEND
'***** END O'LOOP *****
'COLOR 2: LOCATE 1,1:PRINT MOUSE(1);MOUSE(2);" "
Keys:
Kasc=ASC(K$)
IF Kasc=129 OR Kasc=139 THEN GOSUB Help
IF Kasc=130 THEN CALL HAM
IF Kasc=131 THEN CALL HB
IF Kasc=132 THEN COLOR 1,0:CLS:GOSUB Colors
IF Kasc=133 THEN GOSUB Demo
IF Kasc=134 THEN GOSUB Bye
RETURN
Help:
RESTORE: WINDOW 1: COLOR 3,1:CLS
LOCATE 5,10:PRINT "Click here for next line";
LOCATE 2,1: COLOR 2
FOR I=1 TO 7
FOR J=2 TO 3
READ H$: LOCATE J,1:PRINT H$;SPACE$(60)
NEXT
GOSUB WayCheer
NEXT
WINDOW 2
RETURN
Colors:
FOR I=0 TO 315 STEP 5
LINE(I,194)-STEP(5,6),I*.2,bf
NEXT
RETURN
Demo:
CALL HAM
Hi=5: Hi2=4
FOR Green=0 TO 15
Blue=0: Red=0
LINE(0,Green*Hi)-STEP(0,Hi2),0
LINE(1,Green*Hi)-STEP(0,Hi2),Green+48
FOR X=0 TO 7
FOR Red=1 TO 15
LINE(X*32+Red+1,Green*Hi)-STEP(0,Hi2),Red+32
NEXT Red
Blue=Blue+1
LINE(X*32+17,Green*Hi)-STEP(0,Hi2),Blue+16
FOR Red=14 TO 0 STEP -1
LINE(X*32+17+15-Red,Green*Hi)-STEP(0,Hi2),Red+32
NEXT Red
Blue=Blue+1
IF Blue<16 THEN LINE(X*32+33,Green*Hi)-STEP(0,Hi2),Blue+16
NEXT X
NEXT Green
FOR I=0 TO 315 STEP 5
LINE(I*.9,I*.25+90)-STEP(5,12),I*.2,bf
LINE (300,I*.6)-(310,I*.6+3),I*.2,bf
NEXT
RETURN
WayCheer:
MXY=MOUSE(0)
WHILE MOUSE(0)=0: SLEEP: WEND
WHILE MOUSE(0)<>0: SLEEP: WEND
RETURN
NoBMAPS:
PRINT " I can't find the
PRINT ,"Intuition.bmap
PRINT ," or
PRINT ,"Exec.bmap
PRINT ," Click here, then RUN again.";
GOSUB WayCheer
GOTO Bye
RESUME 0
Bye:
WINDOW 1
COLOR 2,1:CLS
PRINT
PRINT,"Thanks for your support
WINDOW CLOSE 2
SCREEN CLOSE 2
LIBRARY CLOSE
END
DATA " A very rudimentary HAM/Half-Bright drawing program."
DATA " It uses the left mouse button and F1 thru F6"
DATA " F1 (or the `HELP' key) gets you here"
DATA " F2 switches to HAM mode"
DATA " F3 switches to Half-Bright mode."
DATA " F4 clears the screen"
DATA " F5 runs a demonstration of sorts.
DATA " F6 Quits the program"
DATA " To select a color, click on one at the bottom of the screen."
DATA " To draw press the left mouse button."
DATA " The HAM and Half-Bright routines are from"
DATA " `Amiga Tricks and Tips' by Abacus press"
DATA ""
DATA " Th...th...th...thats all, folks"
SUB CreateNewPlane STATIC
bitmap&=PEEKL(WINDOW(7)+46)+184
bitplane&=PEEKW(bitmap&)*PEEKW(bitmap&+2)
wdepth%=PEEK(bitmap&+5)
IF wdepth%>5 THEN EXIT SUB
newplane&=AllocMem&(bitplane&,65538&)
IF newplane&=0 THEN ERROR 7
POKEL bitmap&+8+wdepth%*4,newplane&
POKE bitmap&+5,wdepth%+1
IF wdepth%<5 THEN CALL RemakeDisplay
END SUB
SUB HAM STATIC
ViewMode&=PEEKL(WINDOW(7)+46)+76
POKEW ViewMode&,2^11
CALL RemakeDisplay
END SUB
SUB HB STATIC
ViewMode&=PEEKL(WINDOW(7)+46)+76
POKEW ViewMode&,2^7
CALL RemakeDisplay
END SUB